home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hhvbcls / hhsubcla.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-07  |  11.3 KB  |  320 lines
  1. Attribute VB_Name = "modHHSubclass"
  2. ' *****************************************************
  3. ' Code to subclass a Visual Basic form for
  4. ' WM_HELP messaging for HTML Help purposes
  5. ' Version 3.0c
  6. ' (c)August 1999, Delmar Computing Services
  7. '
  8. ' Developed by David Liske, Tipton, Michigan, USA
  9. ' Microsoft HTML Help MVP
  10. ' http://www.vbexplorer.com/htmlhelp.asp
  11. '
  12. ' ATTENTION:
  13. ' Due to the use of the AddressOf operator, this code
  14. ' *will* crash the Visual Basic IDE in Debug mode.
  15. ' If debugging of the application is necessary,
  16. ' uncomment the first Exit Sub in the HHSubclass routine.
  17. ' Again, this routine *cannot* be run in Debug mode.
  18. '
  19. ' To use this module, the subclassed calling form
  20. ' needs to have the following methods included:
  21. '
  22. ' Public Sub OnContextMenu(hWndControl As Long)
  23. ' Public Sub OnHelp(hWndControl As Long)
  24. ' Public Sub OnNavComplete(phhnt As Long)
  25. ' Public Sub OnTCard(wParam As Long, lParam As Long)
  26. ' Public Sub OnTrack(phhnn As Long)
  27. ' Public Sub OnWindowCreate(phhnt As Long)
  28. '
  29. ' Please send any performance or functionality
  30. ' modifications of this file to delmar@tc3net.com
  31. ' *****************************************************
  32.  
  33. Option Explicit
  34.  
  35. ' Notification codes
  36. Private Const HHN_FIRST = -860
  37. Private Const HHN_LAST = -879
  38.  
  39. Private Const HHN_NAVCOMPLETE = HHN_FIRST
  40. Private Const HHN_TRACK = HHN_FIRST - 1
  41. Private Const HHN_WINDOW_CREATE = HHN_FIRST - 2
  42.  
  43. Private Const HH_MAX_TABS = 19
  44.  
  45. 'Windows messaging
  46. Private Const WM_CONTEXTMENU = &H7B
  47. Private Const WM_HELP = &H53
  48. Private Const WM_NCDESTROY = &H82
  49. Private Const WM_NOTIFY = &H4E
  50. Private Const WM_TCARD = &H52
  51.  
  52. Private Const GWL_WNDPROC = (-4)
  53.  
  54. 'Keyboard API
  55. Public Const VK_F1 = &H70
  56. Public Const VK_NUMLOCK = &H90
  57. Public Const VK_CAPITAL = &H14
  58. Public Const VK_SCROLL = &H91
  59.  
  60. ' UDT for mouse cursor position
  61. Private Type POINTAPI
  62.   x As Long
  63.   y As Long
  64. End Type
  65.  
  66. Private Type HELPINFO
  67.   cbSize As Long
  68.   iContextType As Long
  69.   iCtrlId As Long
  70.   hItemHandle As Long
  71.   dwContextId As Long
  72.   MousePos As POINTAPI
  73. End Type
  74.  
  75. Private Type NMHDR
  76.   hwndFrom As Long
  77.   idfrom As Long
  78.   code As Long
  79. End Type
  80.  
  81. Private Type RECT
  82.   Left As Long
  83.   Top As Long
  84.   Right As Long
  85.   Bottom As Long
  86. End Type
  87.  
  88. ' UDT for keyboard API
  89. Private Type KeyboardBytes
  90.   kbByte(0 To 255) As Byte
  91. End Type
  92.  
  93. Public kbArray As KeyboardBytes
  94.  
  95. Private Type HH_WINTYPE
  96.   cbStruct As Integer                         ' IN: size of this structure including all
  97.                                              ' Information Types
  98.   fUniCodeStrings As Boolean                  ' IN/OUT: TRUE if all strings are in UNICODE
  99.   pszType As String                           ' IN/OUT: Name of a type of window
  100.   fsValidMembers As Variant                   ' IN: Bit flag of valid members
  101.                                              ' (HHWIN_PARAM_)
  102.   fsWinProperties As Variant                  ' IN/OUT: Properties/attributes of the window
  103.                                              ' (HHWIN_)
  104.   pszCaption As String                        ' IN/OUT: Window title
  105.   dwStyles As Variant                         ' IN/OUT: Window styles
  106.   dwExStyles As Variant                       ' IN/OUT: Extended Window styles
  107.   rcWindowPos As RECT                         ' IN: Starting position, OUT: current
  108.                                              ' position
  109.   nShowState As Integer                       ' IN: show state (e.g., SW_SHOW)
  110.   hwndHelp As Variant                         ' OUT: window handle
  111.   hwndCaller As Variant                       ' OUT: who called this window
  112.                                              ' The following members are only valid if
  113.                                              ' HHWIN_PROP_TRI_PANE is set
  114.   hwndToolBar As Variant                      ' OUT: toolbar window in tri-pane window
  115.   hwndNavigation As Variant                   ' OUT: navigation window in tri-pane window
  116.   hwndHTML As Variant                         ' OUT: window displaying HTML in tri-pane
  117.                                              ' window
  118.   iNavWidth As Integer                        ' IN/OUT: width of navigation window
  119.   rcHTML As RECT                              ' OUT: HTML window coordinates
  120.   pszToc As String                            ' IN: Location of the table of contents file
  121.   pszIndex As String                           ' IN: Location of the index file
  122.   pszFile As String                           ' IN: Default location of the html file
  123.   pszHome As String                           ' IN/OUT: html file to display when Home
  124.                                              ' button is clicked
  125.   fsToolBarFlags As Variant                   ' IN: flags controling the appearance of the
  126.                                              ' toolbar
  127.   fNotExpanded As Boolean                     ' IN: TRUE/FALSE to contract or expand, OUT:
  128.                                              ' current state
  129.   curNavType As Integer                       ' IN/OUT: UI to display in the navigational
  130.                                              ' pane
  131.   tabpos As Integer                           ' IN/OUT: HHWIN_NAVTAB_TOP, HHWIN_NAVTAB_LEFT,
  132.                                              ' or HHWIN_NAVTAB_BOTTOM
  133.   idNotify As Integer                         ' IN: ID to use for WM_NOTIFY messages
  134.   tabOrder(HH_MAX_TABS + 1) As Byte           ' IN/OUT: tab order: Contents, Index,
  135.                                              ' Search, History, Favorites, Reserved 1-5,
  136.                                              ' Custom tabs
  137.   cHistory As Integer                         ' IN/OUT: number of history items to keep
  138.                                              ' (default is 30)
  139.   pszJump1 As String                          ' Text for HHWIN_BUTTON_JUMP1
  140.   pszJump2 As String                          ' Text for HHWIN_BUTTON_JUMP2
  141.   pszUrlJump1 As String                       ' URL for HHWIN_BUTTON_JUMP1
  142.   pszUrlJump2 As String                       ' URL for HHWIN_BUTTON_JUMP2
  143.   rcMinSize As RECT                           ' Minimum size for window (ignored in version
  144.                                              ' 1 of the Workshop)
  145.   cbInfoTypes As Integer                      ' size of paInfoTypes;
  146. End Type
  147.  
  148. 'UDT for the HHN_TRACK message
  149. Private Type tagHHNTRACK
  150.   hdr As NMHDR
  151.   pszCurUrl As String
  152.   idAction As Integer
  153.   phhWinType As HH_WINTYPE
  154. End Type
  155.  
  156. 'UDT for the HHN_NAVCOMPLETE and HHN_WINDOW_CREATE messages
  157. Private Type tagHHN_NOTIFY
  158.   hdr As NMHDR
  159.   pszUrl As String
  160. End Type
  161.  
  162. Private Declare Function CallWindowProc Lib "user32" _
  163.     Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
  164.     ByVal hwnd As Long, _
  165.     ByVal msgWinMessage As Long, _
  166.     ByVal wParam As Long, _
  167.     lParam As Any) As Long
  168.  
  169. Private Declare Sub CopyMemory Lib "kernel32" _
  170.     Alias "RtlMoveMemory" (Dest As Any, _
  171.     Source As Any, _
  172.     ByVal nLen As Long)
  173.  
  174. Private Declare Function GetWindowLong Lib "user32" _
  175.     Alias "GetWindowLongA" (ByVal hwnd As Long, _
  176.     ByVal nIndex As Long) As Long
  177.     
  178. Private Declare Function SetWindowLong Lib "user32" _
  179.     Alias "SetWindowLongA" (ByVal hwnd As Long, _
  180.     ByVal nIndex As Long, _
  181.     ByVal dwNewLong As Long) As Long
  182.     
  183. Public Declare Function GetKeyState Lib "user32" _
  184.     (ByVal nVirtKey As Long) As Integer
  185.  
  186. Public Declare Function SetKeyboardState Lib "user32" _
  187.     (kbArray As KeyboardBytes) As Long
  188.  
  189. Private colHTMLHelp As New Collection
  190.  
  191. Private Function HHSubclassWndProc(ByVal hwnd As Long, _
  192.   ByVal msgWinMessage As Long, ByVal wParam As Long, _
  193.   ByVal lParam As Long) As Long
  194.  
  195.   Dim colhHelp As Object
  196.     
  197.   ' Loop through all the forms in the collection and use
  198.   ' the handle to determing the message the form belongs to
  199.   For Each colhHelp In colHTMLHelp
  200.     If (colhHelp.hwnd = hwnd) Then
  201.       Exit For
  202.     End If
  203.   Next colhHelp
  204.   
  205.   ' Track down which message was sent and run the
  206.   ' appropriate procedure on the calling form
  207.   Select Case (msgWinMessage)
  208.   Case WM_CONTEXTMENU
  209.     ' The HELP_CONTEXTMENU command causes Help to
  210.     ' display a menu, which is system defined. The
  211.     ' menu contains a What's This command and allows
  212.     ' users to display Help for the control.
  213.     Call colhHelp.frm.OnContextMenu(wParam)
  214.         
  215.   Case WM_HELP
  216.     ' The WM_HELP message is sent whenever the user
  217.     ' presses the F1 key.  It also occurs in response
  218.     ' to What's This Help requests.
  219.     Dim hlpHelpInfo As HELPINFO
  220.     Call CopyMemory(hlpHelpInfo, ByVal lParam, Len(hlpHelpInfo))
  221.     Call colhHelp.frm.OnHelp(hlpHelpInfo.hItemHandle)
  222.         
  223.   Case WM_NOTIFY
  224.     Dim nmhHeader As NMHDR
  225.     Call CopyMemory(nmhHeader, ByVal lParam, Len(nmhHeader))
  226.     
  227.     Select Case (nmhHeader.code)
  228.     Case HHN_NAVCOMPLETE
  229.       ' Sent when the user successfully navigates to a
  230.       ' topic in a compiled HTML Help (.chm) file.
  231.       ' Uses the UDT tagHHN_NOTIFY.
  232.       Call colhHelp.frm.OnNavComplete(lParam)
  233.                 
  234.     Case HHN_TRACK
  235.       ' Sent when a user clicks a button on the toolbar
  236.       ' or a tab in the Navigation pane of the HTML Help
  237.       ' Viewer. The message is sent before the action is
  238.       ' started by the viewer.  Uses the UDT tagHHNTRACK.
  239.       Call colhHelp.frm.OnTrack(lParam)
  240.     
  241.     Case HHN_WINDOW_CREATE
  242.       ' Sent right before an HTML Help window is created.
  243.       ' Uses the UDT tagHHN_NOTIFY.
  244.       Call colhHelp.frm.OnWindowCreate(lParam)
  245.  
  246.     Case Else
  247.       ' Let the message continue on its way
  248.       HHSubclassWndProc = CallWindowProc _
  249.           (colhHelp.lpPrevWndFunc, hwnd, msgWinMessage, _
  250.           wParam, ByVal lParam)
  251.  
  252.     End Select
  253.                 
  254.   Case WM_TCARD
  255.     ' The WM_TCARD message is sent to a program that
  256.     ' has initiated a training card based on Windows
  257.     ' Help technology.  Does not apply to training cards
  258.     ' created via embedded HTML Help.
  259.     Call colhHelp.frm.OnTCard(wParam, lParam)
  260.         
  261.   Case Else
  262.     ' Let the message continue on its way
  263.     HHSubclassWndProc = CallWindowProc _
  264.         (colhHelp.lpPrevWndFunc, hwnd, msgWinMessage, _
  265.         wParam, ByVal lParam)
  266.     
  267.   End Select
  268.  
  269.   If (msgWinMessage = WM_NCDESTROY) Then
  270.     ' If the window no longer exists,
  271.     ' get it out of the HHSubclass collection
  272.     Dim intCount As Integer
  273.     For intCount = 1 To colHTMLHelp.Count
  274.       If (colhHelp Is colHTMLHelp(intCount)) Then
  275.         Call colHTMLHelp.Remove(intCount)
  276.         Exit For
  277.       End If
  278.     Next intCount
  279.   End If
  280.  
  281. End Function
  282.  
  283. Public Sub HHSubclass(frm As Object)
  284.     
  285.   ' Uncomment this line in Debug mode (see the
  286.   ' "Attention" section of the comment block for
  287.   ' this module):
  288.   ' Exit Sub
  289.   
  290.   Dim hHelp As New HTMLHelp
  291.     
  292.   ' Create the object as a form
  293.   Set hHelp.frm = frm
  294.   hHelp.hwnd = frm.hwnd
  295.   hHelp.lpPrevWndFunc = GetWindowLong _
  296.       (frm.hwnd, _
  297.       GWL_WNDPROC)
  298.     
  299.   ' Replace the basic window procedure of the
  300.   ' form calling this procedure
  301.   Call SetWindowLong(frm.hwnd, _
  302.       GWL_WNDPROC, _
  303.       AddressOf HHSubclassWndProc)
  304.     
  305.   ' Put this form into the subclass collection
  306.   ' we created in the Declarations section
  307.   colHTMLHelp.Add hHelp
  308.  
  309. End Sub
  310.  
  311. Public Sub HHUnSubClass(frm As Object)
  312.   
  313.   Dim hHelp As New HTMLHelp
  314.   
  315.   ' Release the subclassed form
  316.   Call SetWindowLong(frm.hwnd, _
  317.       GWL_WNDPROC, hHelp.lpPrevWndFunc)
  318.   
  319. End Sub
  320.